home *** CD-ROM | disk | FTP | other *** search
/ MACD 5 / MACD 5.bin / workbench / blankery / blitzblank / sources / bb.melt < prev    next >
Text File  |  1993-09-17  |  5KB  |  241 lines
  1. ;BB.Melt - Blanker-module for BlitzBlank
  2. ;Copyright 1993 by Thomas Boerkel
  3.  
  4. CloseEd
  5. NoCli
  6.  
  7. NEWTYPE.table
  8. r.l
  9. g.l
  10. b.l
  11. End NEWTYPE
  12.  
  13. NEWTYPE.tags
  14. a.l
  15. b
  16. c
  17. d
  18. e
  19. f
  20. End NEWTYPE
  21.  
  22. DEFTYPE.Screen *fs,*myscreen
  23. DEFTYPE.ViewPort *vp
  24. DEFTYPE.RastPort *rp
  25. DEFTYPE.ColorMap *cm
  26. DEFTYPE.NewScreen newscreen
  27. DEFTYPE.Message *msg
  28. DEFTYPE.table tab
  29. DEFTYPE.MsgPort *port
  30. DEFTYPE.tags tags
  31. DEFTYPE.l
  32.  
  33. Statement stringborder{x,y,w,h}
  34. Wline x+1,y+h+2,x+1,y,x+w+8,y,1
  35. Wline x+w+10,y-1,x+w+10,y+h+4,x-1,y+h+4,1
  36. Wline x,y+h+3,x,y,1
  37. Wline x+w+11,y-1,x+w+11,y+h+4,1
  38. Wline x-1,y+h+3,x-1,y-1,x+w+10,y-1,2
  39. Wline x+w+9,y,x+w+9,y+h+3,x+1,y+h+3,2
  40. Wline x-2,y+h+4,x-2,y-1,2
  41. Wline x+w+8,y+1,x+w+8,y+h+2,2
  42. End Statement
  43.  
  44. Select Par$(1)
  45.   Case "BLANK"
  46.     name$="BB.BlankModule"+Chr$(0)
  47.     *port=CreateMsgPort_()
  48.     *port\mp_Node\ln_Name=&name$
  49.     *port\mp_Node\ln_Pri=1
  50.     AddPort_ *port
  51.     SetTaskPri_ FindTask_(0),Val(Par$(8))
  52.     Gosub readconfig
  53.     speed+30
  54.     lib$="intuition.library"+Chr$(0)
  55.     *ibase.IntuitionBase=OpenLibrary_(&lib$,39)
  56.     CloseLibrary_(*ibase)
  57.  
  58.     If *ibase
  59.       v39=1
  60.     Else
  61.       *ibase.IntuitionBase=OpenLibrary_(&lib$,37)
  62.       CloseLibrary_(*ibase)
  63.     EndIf
  64.  
  65.     *fs=*ibase\FirstScreen
  66.  
  67.     left=*fs\LeftEdge
  68.     top=*fs\TopEdge
  69.     width=*fs\Width
  70.     height=*fs\Height
  71.     modeid=GetVPModeID_(*fs\ViewPort)
  72.  
  73.     depth=*fs\BitMap\Depth
  74.  
  75.     title$="BB.Melt.Screen"+Chr$(0)
  76.     newscreen\LeftEdge=left,top,width,height,depth
  77.     newscreen\ViewModes=0,#CUSTOMSCREEN|#SCREENBEHIND,0,&title$
  78.     tags\a=#SA_DisplayID
  79.     tags\b=modeid
  80.     tags\c=0
  81.     *myscreen=OpenScreenTagList_(newscreen,tags)
  82.     If *myscreen
  83.       *vp=*myscreen\ViewPort
  84.       *rp=*myscreen\RastPort
  85.       *bm=*rp\BitMap
  86.       BltBitMap_ *fs\BitMap,0,0,*myscreen\BitMap,0,0,width,height,$C0,$FF,0
  87.       *cm=*fs\ViewPort\ColorMap
  88.       For i=0 To 2^depth
  89.         If v39
  90.           GetRGB32_ *cm,i,1,tab
  91.           SetRGB32_ *vp,i,tab\r,tab\g,tab\b
  92.         Else
  93.           c=GetRGB4_(*cm,i)
  94.           SetRGB4_ *vp,i,(c LSR 8) AND 15,(c LSR 4) AND 15,c AND 15
  95.         EndIf
  96.       Next i
  97.       ScreenToFront_ *myscreen
  98.  
  99.       Repeat
  100.         VWait
  101.         For i=1 To speed
  102.           x=Rnd(width-size)
  103.           y=Rnd(height-3)
  104.           If ReadPixel_(*rp,x,y)
  105.             BltBitMap_ *bm,x,y,*bm,x,y+1,size,1,$C0,$FF,0
  106.             BltBitMap_ *bm,x,y,*bm,x,y+2,size,1,$C0,$FF,0
  107.             a+1
  108.           EndIf
  109.         Next i
  110.         If a>500000
  111.           BltBitMap_ *fs\BitMap,0,0,*myscreen\BitMap,0,0,width,height,$C0,$FF,0
  112.           a=0
  113.         EndIf
  114.         *msg=GetMsg_(*port)
  115.       Until *msg
  116.  
  117.       CloseScreen_ *myscreen
  118.     EndIf
  119.     RemPort_ *port
  120.     DeleteMsgPort_ *port
  121.  
  122.   Case "INFO"
  123.     title$="Melt"+Chr$(0)
  124.     reqtext$="Melt - Module for BlitzBlank"+Chr$(10)
  125.     reqtext$+Chr$(169)+" 1993 by Thomas Brkel"+Chr$(10)+Chr$(10)
  126.     reqtext$+"Your actual screen will be melted."+Chr$(10)+Chr$(10)
  127.     reqtext$+"Choose the speed and size in the config-window."+Chr$(0)
  128.     gadget$="OK"+Chr$(0)
  129.     easy.EasyStruct\es_StructSize=SizeOf.EasyStruct
  130.     easy\es_Title=&title$
  131.     easy\es_TextFormat=&reqtext$
  132.     easy\es_GadgetFormat=&gadget$
  133.     EasyRequestArgs_ 0,easy,0,0
  134.   Case "CONFIG"
  135.     *myscreen=LockPubScreen_(0)
  136.     width=*myscreen\Width
  137.     height=*myscreen\Height
  138.     font=*myscreen\Font\ta_YSize
  139.     Gosub readconfig
  140.     WbToScreen 0
  141.     BorderPens 0,0
  142.     StringGadget 0,100,25,0,0,4,40
  143.     StringGadget 0,100,50,0,1,4,40
  144.     SetString 0,0,Str$(speed)
  145.     SetString 0,1,Str$(size)
  146.     Window 0,width/2-90,height/2-40,180,80,$100e,"Melt",1,2,0
  147.     stringborder{100,25,40,8}
  148.     stringborder{100,50,40,8}
  149.     WColour 2
  150.     WLocate 30,24-font
  151.     Print "Speed:"
  152.     WLocate 30,24-font+8
  153.     Print "(1-150)"
  154.     WLocate 30,49-font
  155.     Print "Size:"
  156.     WLocate 30,49-font+8
  157.     Print "(1-100)"
  158.     ActivateString 0,0
  159.     Repeat
  160.       ev=WaitEvent
  161.       If ev=$40
  162.         Select GadgetHit
  163.           Case 0
  164.             ActivateString 0,1
  165.           Case 1
  166.             e=1
  167.         End Select
  168.       EndIf
  169.     Until ev=$200 OR e
  170.     speed=Val(StringText$(0,0))
  171.     size=Val(StringText$(0,1))
  172.     Free Window 0
  173.     Gosub writeconfig
  174.     UnlockPubScreen_ 0,*myscreen
  175. End Select
  176.  
  177. End
  178.  
  179. .readconfig
  180. path$=Par$(9)
  181. For i=10 To NumPars
  182.   path$=path$+" "+Par$(i)
  183. Next i
  184. If ReadFile(0,path$+"BB.Modules.config")
  185.   FileInput 0
  186.   While NOT Eof(0)
  187.     If Edit$(100)="*** Melt ***"
  188.       speed=Val(Edit$(5))
  189.       size=Val(Edit$(5))
  190.     EndIf
  191.   Wend
  192.   DefaultInput
  193.   CloseFile 0
  194. EndIf
  195. Gosub checkval
  196. Return
  197.  
  198.  
  199. .writeconfig
  200. Gosub checkval
  201. If ReadFile(0,path$+"BB.Modules.config")
  202.   If WriteFile(1,path$+"BB.Modules.temp")
  203.     FileInput 0
  204.     FileOutput 1
  205.     While NOT Eof(0)
  206.       f$=Edit$(100)
  207.       If f$="*** Melt ***"
  208.         Repeat
  209.           f2$=Edit$(100)
  210.         Until Eof(0) OR Left$(f2$,3)="***"
  211.         If NOT Eof(0) Then NPrint f2$
  212.       Else
  213.         NPrint f$
  214.       EndIf
  215.     Wend
  216.     CloseFile 1
  217.   EndIf
  218.   CloseFile 0
  219. EndIf
  220. KillFile path$+"BB.Modules.config"
  221. f$=path$+"BB.Modules.temp"+Chr$(0)
  222. f2$=path$+"BB.Modules.config"+Chr$(0)
  223. Rename_ &f$,&f2$
  224. If OpenFile(0,path$+"BB.Modules.config")
  225.   FileOutput 0
  226.   FileSeek 0,Lof(0)
  227.   NPrint "*** Melt ***"
  228.   NPrint speed
  229.   NPrint size
  230.   CloseFile 0
  231. EndIf
  232. Return
  233.  
  234. .checkval
  235. If speed<1 Then speed=100
  236. If speed>150 Then speed=100
  237. If size<1 Then size=30
  238. If size>100 Then size=30
  239. Return
  240.  
  241.